;;; examples-of-lexical-addressing-and-tail-call-annotation.scm
;;; Examples of what my compiler outputs for the tail-call annotation
;;; and lexical addressing problems. Note that my compiler generates
;;; slightly different tags for the AST than what the class was asked
;;; to generate. This should not be a problem.
;;;
;;; Programmer: Mayer Goldberg, 2009

> (load "compiler.scm")
> (define (rep)
    (display ">> ")
    (let ((e (read)))
      (if (ormap (lambda (q) (eq? e q))
		 '(exit done out bye quit finish))
	  'bye
	  (begin
	    (pretty-print
	     (pe->lex-pe
	      (annotate-tc
	       (remove-applic-lambda-nil
		(box-set
		 (eliminate-nested-defines
		  (parse e)))))))
	    (rep)))))
> (rep)
>> (lambda (x) (x x))
(lambda-simple (x) (tc-applic (pvar x 0) ((pvar x 0))))
>> ((lambda (x) (x x)) (lambda (x) (x x)))
(tc-applic
 (lambda-simple (x) (tc-applic (pvar x 0) ((pvar x 0))))
 ((lambda-simple (x) (tc-applic (pvar x 0) ((pvar x 0))))))
>> (lambda (x) (x (x x)))
(lambda-simple
 (x)
 (tc-applic (pvar x 0) ((applic (pvar x 0) ((pvar x 0))))))
>> (define fact
     (lambda (n)
       (if (zero? n) 
	   1
	   (* n (fact (- n 1))))))
(def (fvar fact)
     (lambda-simple
      (n)
      (if3 (applic (fvar zero?) ((pvar n 0)))
	   (const 1)
	   (tc-applic
	    (fvar *)
	    ((pvar n 0)
	     (applic
	      (fvar fact)
	      ((applic (fvar -) ((pvar n 0) (const 1))))))))))
>> (define y
     (lambda (f)
       ((lambda (x)
	  (f (lambda args
	       (apply (x x) args))))
	(lambda (x)
	  (f (lambda args
	       (apply (x x) args)))))))
(def (fvar y)
     (lambda-simple
      (f)
      (tc-applic
       (lambda-simple
	(x)
	(tc-applic
	 (bvar f 0 0)
	 ((lambda-var
	   args
	   (tc-applic
	    (fvar apply)
	    ((applic (bvar x 0 0) ((bvar x 0 0))) (pvar args 0)))))))
       ((lambda-simple
	 (x)
	 (tc-applic
	  (bvar f 0 0)
	  ((lambda-var
	    args
	    (tc-applic
	     (fvar apply)
	     ((applic (bvar x 0 0) ((bvar x 0 0)))
	      (pvar args 0)))))))))))
>> (lambda (a) 
     (lambda (b)
       (lambda (c)
	 ((a c) (b c)))))
(lambda-simple
 (a)
 (lambda-simple
  (b)
  (lambda-simple
   (c)
   (tc-applic
    (applic (bvar a 1 0) ((pvar c 0)))
    ((applic (bvar b 0 0) ((pvar c 0))))))))
>> (define order
     (lambda (<)
       (letrec ((loop
		 (lambda (a s)
		   (or (null? s)
		       (and (< a (car s))
			    (loop (car s) (cdr s)))))))
	 (lambda (a . s)
	   (loop a s)))))
(def (fvar order)
     (lambda-simple
      (<)
      (tc-applic
       (lambda-simple
	(loop)
	(seq ((set (pvar loop 0)
		   (applic (fvar cons) ((pvar loop 0) (const ()))))
	      (applic
	       (fvar set-car!)
	       ((pvar loop 0)
		(lambda-simple
		 (a s)
		 (or ((applic (fvar null?) ((pvar s 1)))
		      (if3 (applic
			    (bvar < 1 0)
			    ((pvar a 0)
			     (applic (fvar car) ((pvar s 1)))))
			   (tc-applic
			    (applic (fvar car) ((bvar loop 0 0)))
			    ((applic (fvar car) ((pvar s 1)))
			     (applic (fvar cdr) ((pvar s 1)))))
			   (const #f)))))))
	      (lambda-opt
	       (a)
	       s
	       (tc-applic
		(applic (fvar car) ((bvar loop 0 0)))
		((pvar a 0) (pvar s 1)))))))
       ((const #f)))))
>> (define map
     (letrec ((map-list
	       (lambda (f lists)
		 (if (null? (car lists)) '()
		     (cons (apply f (map-one car lists))
			   (map-list f (map-one cdr lists))))))
	      (map-one
	       (lambda (f s)
		 (if (null? s) '()
		     (cons (f (car s))
			   (map-one f (cdr s)))))))
       (lambda (f . args)
	 (map-list f args))))
(def (fvar map)
     (applic
      (lambda-simple
       (map-list map-one)
       (seq ((set (pvar map-list 0)
		  (applic (fvar cons) ((pvar map-list 0) (const ()))))
	     (set (pvar map-one 1)
		  (applic (fvar cons) ((pvar map-one 1) (const ()))))
	     (applic
	      (fvar set-car!)
	      ((pvar map-list 0)
	       (lambda-simple
		(f lists)
		(if3 (applic
		      (fvar null?)
		      ((applic (fvar car) ((pvar lists 1)))))
		     (const ())
		     (tc-applic
		      (fvar cons)
		      ((applic
			(fvar apply)
			((pvar f 0)
			 (applic
			  (applic
			   (fvar car)
			   ((bvar map-one 0 1)))
			  ((fvar car) (pvar lists 1)))))
		       (applic
			(applic (fvar car) ((bvar map-list 0 0)))
			((pvar f 0)
			 (applic
			  (applic
			   (fvar car)
			   ((bvar map-one 0 1)))
			  ((fvar cdr) (pvar lists 1)))))))))))
	     (applic
	      (fvar set-car!)
	      ((pvar map-one 1)
	       (lambda-simple
		(f s)
		(if3 (applic (fvar null?) ((pvar s 1)))
		     (const ())
		     (tc-applic
		      (fvar cons)
		      ((applic
			(pvar f 0)
			((applic (fvar car) ((pvar s 1)))))
		       (applic
			(applic (fvar car) ((bvar map-one 0 1)))
			((pvar f 0)
			 (applic (fvar cdr) ((pvar s 1)))))))))))
	     (lambda-opt
	      (f)
	      args
	      (tc-applic
	       (applic (fvar car) ((bvar map-list 0 0)))
	       ((pvar f 0) (pvar args 1)))))))
      ((const #f) (const #f))))
>> (define member?
     (lambda (a s)
       (ormap (lambda (b) (eq? a b)) s)))
(def (fvar member?)
     (lambda-simple
      (a s)
      (tc-applic
       (fvar ormap)
       ((lambda-simple
	 (b)
	 (tc-applic (fvar eq?) ((bvar a 0 0) (pvar b 0))))
	(pvar s 1)))))
>> (define andmap
     (lambda (f . s)
       (letrec ((loop
		 (lambda (s)
		   (or (null? (car s))
		       (and (apply f (map car s))
			    (loop (map cdr s)))))))
	 (loop s))))
(def (fvar andmap)
     (lambda-opt
      (f)
      s
      (tc-applic
       (lambda-simple
	(loop)
	(seq ((set (pvar loop 0)
		   (applic (fvar cons) ((pvar loop 0) (const ()))))
	      (applic
	       (fvar set-car!)
	       ((pvar loop 0)
		(lambda-simple
		 (s)
		 (or ((applic
		       (fvar null?)
		       ((applic (fvar car) ((pvar s 0)))))
		      (if3 (applic
			    (fvar apply)
			    ((bvar f 1 0)
			     (applic
			      (fvar map)
			      ((fvar car) (pvar s 0)))))
			   (tc-applic
			    (applic (fvar car) ((bvar loop 0 0)))
			    ((applic
			      (fvar map)
			      ((fvar cdr) (pvar s 0)))))
			   (const #f)))))))
	      (tc-applic
	       (applic (fvar car) ((pvar loop 0)))
	       ((bvar s 0 1))))))
       ((const #f)))))
>> (define string->list
     (letrec ((loop
	       (lambda (str n s)
		 (if (= n -1) s
		     (loop str
			   (- n 1)
			   (cons (string-ref str n) s))))))
       (lambda (str)
	 (loop str (- (string-length str) 1) '()))))
(def (fvar string->list)
     (applic
      (lambda-simple
       (loop)
       (seq ((set (pvar loop 0)
		  (applic (fvar cons) ((pvar loop 0) (const ()))))
	     (applic
	      (fvar set-car!)
	      ((pvar loop 0)
	       (lambda-simple
		(str n s)
		(if3 (applic (fvar =) ((pvar n 1) (const -1)))
		     (pvar s 2)
		     (tc-applic
		      (applic (fvar car) ((bvar loop 0 0)))
		      ((pvar str 0)
		       (applic (fvar -) ((pvar n 1) (const 1)))
		       (applic
			(fvar cons)
			((applic
			  (fvar string-ref)
			  ((pvar str 0) (pvar n 1)))
			 (pvar s 2)))))))))
	     (lambda-simple
	      (str)
	      (tc-applic
	       (applic (fvar car) ((bvar loop 0 0)))
	       ((pvar str 0)
		(applic
		 (fvar -)
		 ((applic (fvar string-length) ((pvar str 0)))
		  (const 1)))
		(const ())))))))
      ((const #f))))
>> (define is-equal?
     (let ((void-object (if #f #f)))
       (letrec ((equal?
		 (lambda (a b)
		   (cond
		    ;; bool
		    ((and (boolean? a) (boolean? b))
		     (if a b (not b)))
		    ;; char
		    ((and (char? a) (char? b)) (char=? a b))
		    ;; nil
		    ((null? a) (null? b))
		    ;; number
		    ((and (number? a) (number? b)) (= a b))
		    ;; pair
		    ((and (pair? a) (pair? b))
		     (and (equal? (car a) (car b))
			  (equal? (cdr a) (cdr b))))
		    ;; string
		    ((and (string? a) (string? b)) (string=? a b))
		    ;; symbol
		    ((and (symbol? a) (symbol? b)) (eq? a b))
		    ;; vector
		    ((and (vector? a) (vector? b)
			  (= (vector-length a) (vector-length b)))
		     (map equal? (vector->list a) (vector->list b)))
		    ;; void
		    ((eq? a void-object) (eq? b void-object))
		    (else #f)))))
	 equal?)))
(def (fvar is-equal?)
     (applic
      (lambda-simple
       (void-object)
       (tc-applic
	(lambda-simple
	 (equal?)
	 (seq ((set (pvar equal? 0)
		    (applic (fvar cons) ((pvar equal? 0) (const ()))))
	       (applic
		(fvar set-car!)
		((pvar equal? 0)
		 (lambda-simple
		  (a b)
		  (if3 (if3 (applic (fvar boolean?) ((pvar a 0)))
			    (applic (fvar boolean?) ((pvar b 1)))
			    (const #f))
		       (if3 (pvar a 0)
			    (pvar b 1)
			    (tc-applic (fvar not) ((pvar b 1))))
		       (if3 (if3 (applic (fvar char?) ((pvar a 0)))
				 (applic (fvar char?) ((pvar b 1)))
				 (const #f))
			    (tc-applic
			     (fvar char=?)
			     ((pvar a 0) (pvar b 1)))
			    (if3 (applic (fvar null?) ((pvar a 0)))
				 (tc-applic
				  (fvar null?)
				  ((pvar b 1)))
				 (if3 (if3 (applic
					    (fvar number?)
					    ((pvar a 0)))
					   (applic
					    (fvar number?)
					    ((pvar b 1)))
					   (const #f))
				      (tc-applic
				       (fvar =)
				       ((pvar a 0) (pvar b 1)))
				      (if3 (if3 (applic
						 (fvar pair?)
						 ((pvar a 0)))
						(applic
						 (fvar pair?)
						 ((pvar b 1)))
						(const #f))
					   (if3 (applic
						 (applic
						  (fvar car)
						  ((bvar
						    equal?
						    0
						    0)))
						 ((applic
						   (fvar car)
						   ((pvar a 0)))
						  (applic
						   (fvar car)
						   ((pvar
						     b
						     1)))))
						(tc-applic
						 (applic
						  (fvar car)
						  ((bvar
						    equal?
						    0
						    0)))
						 ((applic
						   (fvar cdr)
						   ((pvar a 0)))
						  (applic
						   (fvar cdr)
						   ((pvar
						     b
						     1)))))
						(const #f))
					   (if3 (if3 (applic
						      (fvar
						       string?)
						      ((pvar
							a
							0)))
						     (applic
						      (fvar
						       string?)
						      ((pvar
							b
							1)))
						     (const #f))
						(tc-applic
						 (fvar string=?)
						 ((pvar a 0)
						  (pvar b 1)))
						(if3 (if3 (applic
							   (fvar
							    symbol?)
							   ((pvar
							     a
							     0)))
							  (applic
							   (fvar
							    symbol?)
							   ((pvar
							     b
							     1)))
							  (const
							   #f))
						     (tc-applic
						      (fvar eq?)
						      ((pvar a 0)
						       (pvar
							b
							1)))
						     (if3 (if3 (applic
								(fvar
								 vector?)
								((pvar
								  a
								  0)))
							       (if3 (applic
								     (fvar
								      vector?)
								     ((pvar
								       b
								       1)))
								    (applic
								     (fvar
								      =)
								     ((applic
								       (fvar
									vector-length)
								       ((pvar
									 a
									 0)))
								      (applic
								       (fvar
									vector-length)
								       ((pvar
									 b
									 1)))))
								    (const
								     #f))
							       (const
								#f))
							  (tc-applic
							   (fvar
							    map)
							   ((applic
							     (fvar
							      car)
							     ((bvar
							       equal?
							       0
							       0)))
							    (applic
							     (fvar
							      vector->list)
							     ((pvar
							       a
							       0)))
							    (applic
							     (fvar
							      vector->list)
							     ((pvar
							       b
							       1)))))
							  (if3 (applic
								(fvar
								 eq?)
								((pvar
								  a
								  0)
								 (bvar
								  void-object
								  1
								  0)))
							       (tc-applic
								(fvar
								 eq?)
								((pvar
								  b
								  1)
								 (bvar
								  void-object
								  1
								  0)))
							       (const
								#f)))))))))))))
	       (tc-applic (fvar car) ((pvar equal? 0))))))
	((const #f))))
      ((if3 (const #f) (const #f) (const #<void>)))))
>> (define bin
     (lambda (n s)
       (if (zero? n) (list s)
	   (append
	    (bin (sub1 n) (cons 0 s))
	    (bin (sub1 n) (cons 1 s))))))
(def (fvar bin)
     (lambda-simple
      (n s)
      (if3 (applic (fvar zero?) ((pvar n 0)))
	   (tc-applic (fvar list) ((pvar s 1)))
	   (tc-applic
	    (fvar append)
	    ((applic
	      (fvar bin)
	      ((applic (fvar sub1) ((pvar n 0)))
	       (applic (fvar cons) ((const 0) (pvar s 1)))))
	     (applic
	      (fvar bin)
	      ((applic (fvar sub1) ((pvar n 0)))
	       (applic (fvar cons) ((const 1) (pvar s 1))))))))))
>> (define cross-map
     (lambda (s f)
       (letrec ((run-h
		 (lambda (s args)
		   (if (null? s)
		       (list (apply f (reverse args)))
		       (run-v (car s) (cdr s) args))))
		(run-v
		 (lambda (n s args)
		   (if (zero? n)
		       '()
		       (append
			(run-h s (cons (- n 1) args))
			(run-v (- n 1) s args))))))
	 (run-h s '()))))
(def (fvar cross-map)
     (lambda-simple
      (s f)
      (tc-applic
       (lambda-simple
	(run-h run-v)
	(seq ((set (pvar run-h 0)
		   (applic (fvar cons) ((pvar run-h 0) (const ()))))
	      (set (pvar run-v 1)
		   (applic (fvar cons) ((pvar run-v 1) (const ()))))
	      (applic
	       (fvar set-car!)
	       ((pvar run-h 0)
		(lambda-simple
		 (s args)
		 (if3 (applic (fvar null?) ((pvar s 0)))
		      (tc-applic
		       (fvar list)
		       ((applic
			 (fvar apply)
			 ((bvar f 1 1)
			  (applic
			   (fvar reverse)
			   ((pvar args 1)))))))
		      (tc-applic
		       (applic (fvar car) ((bvar run-v 0 1)))
		       ((applic (fvar car) ((pvar s 0)))
			(applic (fvar cdr) ((pvar s 0)))
			(pvar args 1)))))))
	      (applic
	       (fvar set-car!)
	       ((pvar run-v 1)
		(lambda-simple
		 (n s args)
		 (if3 (applic (fvar zero?) ((pvar n 0)))
		      (const ())
		      (tc-applic
		       (fvar append)
		       ((applic
			 (applic (fvar car) ((bvar run-h 0 0)))
			 ((pvar s 1)
			  (applic
			   (fvar cons)
			   ((applic
			     (fvar -)
			     ((pvar n 0) (const 1)))
			    (pvar args 2)))))
			(applic
			 (applic (fvar car) ((bvar run-v 0 1)))
			 ((applic
			   (fvar -)
			   ((pvar n 0) (const 1)))
			  (pvar s 1)
			  (pvar args 2)))))))))
	      (tc-applic
	       (applic (fvar car) ((pvar run-h 0)))
	       ((bvar s 0 0) (const ()))))))
       ((const #f) (const #f)))))
>> (define show
     ((lambda (ma)
	((lambda (ai)
	   (lambda (board)
	     ((board (ma ai 'x) (ma ai 'o) (ma ai'_))
	      (lambda (x y) (lambda (r) `(lambda (x o _) ,r)))
	      #f)))
	 (lambda (m1 m2)
	   (lambda (c)
	     (lambda (b)
	       (lambda (a)
		 (ma m1 (list a b c))))))))
      (lambda (m r) (lambda (x y) ((x y m) r)))))
(def (fvar show)
     (applic
      (lambda-simple
       (ma)
       (tc-applic
	(lambda-simple
	 (ai)
	 (lambda-simple
	  (board)
	  (tc-applic
	   (applic
	    (pvar board 0)
	    ((applic (bvar ma 1 0) ((bvar ai 0 0) (const x)))
	     (applic (bvar ma 1 0) ((bvar ai 0 0) (const o)))
	     (applic (bvar ma 1 0) ((bvar ai 0 0) (const _)))))
	   ((lambda-simple
	     (x y)
	     (lambda-simple
	      (r)
	      (tc-applic
	       (fvar append)
	       ((const (lambda))
		(applic
		 (fvar append)
		 ((applic
		   (fvar list)
		   ((applic
		     (fvar append)
		     ((const (x))
		      (applic
		       (fvar append)
		       ((const (o))
			(applic
			 (fvar append)
			 ((const (_)) (const ())))))))))
		  (applic
		   (fvar append)
		   ((applic (fvar list) ((pvar r 0)))
		    (const ())))))))))
	    (const #f)))))
	((lambda-simple
	  (m1 m2)
	  (lambda-simple
	   (c)
	   (lambda-simple
	    (b)
	    (lambda-simple
	     (a)
	     (tc-applic
	      (bvar ma 3 0)
	      ((bvar m1 2 0)
	       (applic
		(fvar list)
		((pvar a 0) (bvar b 0 0) (bvar c 1 0))))))))))))
      ((lambda-simple
	(m r)
	(lambda-simple
	 (x y)
	 (tc-applic
	  (applic (pvar x 0) ((pvar y 1) (bvar m 0 0)))
	  ((bvar r 0 1))))))))
>> (define qsort
     (lambda (s)
       (if (null? s) '()
	   (split (car s) (cdr s)
		  (lambda (ll gl)
		    (append (qsort ll)
			    (list (car s))
			    (qsort gl)))))))
(def (fvar qsort)
     (lambda-simple
      (s)
      (if3 (applic (fvar null?) ((pvar s 0)))
	   (const ())
	   (tc-applic
	    (fvar split)
	    ((applic (fvar car) ((pvar s 0)))
	     (applic (fvar cdr) ((pvar s 0)))
	     (lambda-simple
	      (ll gl)
	      (tc-applic
	       (fvar append)
	       ((applic (fvar qsort) ((pvar ll 0)))
		(applic
		 (fvar list)
		 ((applic (fvar car) ((bvar s 0 0)))))
		(applic (fvar qsort) ((pvar gl 1)))))))))))
>> (define split
     (lambda (pivot s ret-ll+gl)
       (if (null? s) (ret-ll+gl '() '())
	   (split pivot (cdr s)
		  (lambda (ll gl)
		    (if (<= (car s) pivot)
			(ret-ll+gl (cons (car s) ll) gl)
			(ret-ll+gl ll (cons (car s) gl))))))))
(def (fvar split)
     (lambda-simple
      (pivot s ret-ll+gl)
      (if3 (applic (fvar null?) ((pvar s 1)))
	   (tc-applic (pvar ret-ll+gl 2) ((const ()) (const ())))
	   (tc-applic
	    (fvar split)
	    ((pvar pivot 0)
	     (applic (fvar cdr) ((pvar s 1)))
	     (lambda-simple
	      (ll gl)
	      (if3 (applic
		    (fvar <=)
		    ((applic (fvar car) ((bvar s 0 1)))
		     (bvar pivot 0 0)))
		   (tc-applic
		    (bvar ret-ll+gl 0 2)
		    ((applic
		      (fvar cons)
		      ((applic (fvar car) ((bvar s 0 1)))
		       (pvar ll 0)))
		     (pvar gl 1)))
		   (tc-applic
		    (bvar ret-ll+gl 0 2)
		    ((pvar ll 0)
		     (applic
		      (fvar cons)
		      ((applic (fvar car) ((bvar s 0 1)))
		       (pvar gl 1))))))))))))
>> (a (lambda (a) (a (lambda (b) (a b (lambda (a) (a b (lambda (c) (a b c)))))))))
(tc-applic
 (fvar a)
 ((lambda-simple
   (a)
   (tc-applic
    (pvar a 0)
    ((lambda-simple
      (b)
      (tc-applic
       (bvar a 0 0)
       ((pvar b 0)
	(lambda-simple
	 (a)
	 (tc-applic
	  (pvar a 0)
	  ((bvar b 0 0)
	   (lambda-simple
	    (c)
	    (tc-applic
	     (bvar a 0 0)
	     ((bvar b 1 0) (pvar c 0)))))))))))))))
>> (define list->string
     (lambda (s)
       (let* ((n (length s))
	      (str (make-string n)))
	 (letrec ((loop
		   (lambda (s i)
		     (if (= i n) str
			 (begin
			   (string-set! str i (car s))
			   (loop (cdr s) (+ i 1)))))))
	   (loop s 0)))))
(def (fvar list->string)
     (lambda-simple
      (s)
      (tc-applic
       (lambda-simple
	(n)
	(tc-applic
	 (lambda-simple
	  (str)
	  (tc-applic
	   (lambda-simple
	    (loop)
	    (seq ((set (pvar loop 0)
		       (applic
			(fvar cons)
			((pvar loop 0) (const ()))))
		  (applic
		   (fvar set-car!)
		   ((pvar loop 0)
		    (lambda-simple
		     (s i)
		     (if3 (applic
			   (fvar =)
			   ((pvar i 1) (bvar n 2 0)))
			  (bvar str 1 0)
			  (seq ((applic
				 (fvar string-set!)
				 ((bvar str 1 0)
				  (pvar i 1)
				  (applic
				   (fvar car)
				   ((pvar s 0)))))
				(tc-applic
				 (applic
				  (fvar car)
				  ((bvar loop 0 0)))
				 ((applic
				   (fvar cdr)
				   ((pvar s 0)))
				  (applic
				   (fvar +)
				   ((pvar i 1)
				    (const 1)))))))))))
		  (tc-applic
		   (applic (fvar car) ((pvar loop 0)))
		   ((bvar s 2 0) (const 0))))))
	   ((const #f))))
	 ((applic (fvar make-string) ((pvar n 0))))))
       ((applic (fvar length) ((pvar s 0)))))))
>> (define list->vector
     (lambda (s)
       (let* ((n (length s))
	      (v (make-vector n)))
	 (letrec ((loop
		   (lambda (s i)
		     (if (= i n) v
			 (begin
			   (vector-set! v i (car s))
			   (loop (cdr s) (+ i 1)))))))
	   (loop s 0)))))
(def (fvar list->vector)
     (lambda-simple
      (s)
      (tc-applic
       (lambda-simple
	(n)
	(tc-applic
	 (lambda-simple
	  (v)
	  (tc-applic
	   (lambda-simple
	    (loop)
	    (seq ((set (pvar loop 0)
		       (applic
			(fvar cons)
			((pvar loop 0) (const ()))))
		  (applic
		   (fvar set-car!)
		   ((pvar loop 0)
		    (lambda-simple
		     (s i)
		     (if3 (applic
			   (fvar =)
			   ((pvar i 1) (bvar n 2 0)))
			  (bvar v 1 0)
			  (seq ((applic
				 (fvar vector-set!)
				 ((bvar v 1 0)
				  (pvar i 1)
				  (applic
				   (fvar car)
				   ((pvar s 0)))))
				(tc-applic
				 (applic
				  (fvar car)
				  ((bvar loop 0 0)))
				 ((applic
				   (fvar cdr)
				   ((pvar s 0)))
				  (applic
				   (fvar +)
				   ((pvar i 1)
				    (const 1)))))))))))
		  (tc-applic
		   (applic (fvar car) ((pvar loop 0)))
		   ((bvar s 2 0) (const 0))))))
	   ((const #f))))
	 ((applic (fvar make-vector) ((pvar n 0))))))
       ((applic (fvar length) ((pvar s 0)))))))
>> (define pred
     (lambda (n)
       (lambda (z)
	 (lambda (w)
	   (let
	       ((M (lambda (m)
		     (lambda (b2)
		       (lambda (r21)
			 (lambda (r22)
			   (lambda (s2)
			     (lambda (b1)
			       (lambda (r11)
				 (lambda (r12)
				   (lambda (s1)
				     ((s1
				       (((b1
					  (((b2 (quintuple m b2 (r12 w) (r12 w) U01))
					    (quintuple m b2 (r12 w) (r12 w) U01))
					   (r12 w)))
					 (((b2 (quintuple m b2 r11 (r12 z) U11))
					   (quintuple m b2 r11 (r12 z) U11))
					  r11))
					I))
				      (((b1 (((b2 (quintuple m b2 r11 (r12 z) U11))
					      (quintuple m b2 r11 (r12 z) U11))
					     r11))
					(((b2 (quintuple m b2 (r12 w) (r12 w) U11))
					  (quintuple m b2 (r12 w) (r12 w) U11))
					 (r12 w)))
				       I)))))))))))))
	     (((n (quintuple M U02 z I U01))
	       (quintuple M U12 z I U01))
	      (quintuple M U22 z I U01)))))))
(def (fvar pred)
     (lambda-simple
      (n)
      (lambda-simple
       (z)
       (lambda-simple
	(w)
	(tc-applic
	 (lambda-simple
	  (M)
	  (tc-applic
	   (applic
	    (applic
	     (bvar n 2 0)
	     ((applic
	       (fvar quintuple)
	       ((pvar M 0)
		(fvar U02)
		(bvar z 1 0)
		(fvar I)
		(fvar U01)))))
	    ((applic
	      (fvar quintuple)
	      ((pvar M 0)
	       (fvar U12)
	       (bvar z 1 0)
	       (fvar I)
	       (fvar U01)))))
	   ((applic
	     (fvar quintuple)
	     ((pvar M 0)
	      (fvar U22)
	      (bvar z 1 0)
	      (fvar I)
	      (fvar U01))))))
	 ((lambda-simple
	   (m)
	   (lambda-simple
	    (b2)
	    (lambda-simple
	     (r21)
	     (lambda-simple
	      (r22)
	      (lambda-simple
	       (s2)
	       (lambda-simple
		(b1)
		(lambda-simple
		 (r11)
		 (lambda-simple
		  (r12)
		  (lambda-simple
		   (s1)
		   (tc-applic
		    (applic
		     (pvar s1 0)
		     ((applic
		       (applic
			(applic
			 (bvar b1 2 0)
			 ((applic
			   (applic
			    (applic
			     (bvar b2 6 0)
			     ((applic
			       (fvar quintuple)
			       ((bvar m 7 0)
				(bvar b2 6 0)
				(applic
				 (bvar r12 0 0)
				 ((bvar w 8 0)))
				(applic
				 (bvar r12 0 0)
				 ((bvar w 8 0)))
				(fvar U01)))))
			    ((applic
			      (fvar quintuple)
			      ((bvar m 7 0)
			       (bvar b2 6 0)
			       (applic
				(bvar r12 0 0)
				((bvar w 8 0)))
			       (applic
				(bvar r12 0 0)
				((bvar w 8 0)))
			       (fvar U01)))))
			   ((applic
			     (bvar r12 0 0)
			     ((bvar w 8 0)))))))
			((applic
			  (applic
			   (applic
			    (bvar b2 6 0)
			    ((applic
			      (fvar quintuple)
			      ((bvar m 7 0)
			       (bvar b2 6 0)
			       (bvar r11 1 0)
			       (applic
				(bvar r12 0 0)
				((bvar z 9 0)))
			       (fvar U11)))))
			   ((applic
			     (fvar quintuple)
			     ((bvar m 7 0)
			      (bvar b2 6 0)
			      (bvar r11 1 0)
			      (applic
			       (bvar r12 0 0)
			       ((bvar z 9 0)))
			      (fvar U11)))))
			  ((bvar r11 1 0)))))
		       ((fvar I)))))
		    ((applic
		      (applic
		       (applic
			(bvar b1 2 0)
			((applic
			  (applic
			   (applic
			    (bvar b2 6 0)
			    ((applic
			      (fvar quintuple)
			      ((bvar m 7 0)
			       (bvar b2 6 0)
			       (bvar r11 1 0)
			       (applic
				(bvar r12 0 0)
				((bvar z 9 0)))
			       (fvar U11)))))
			   ((applic
			     (fvar quintuple)
			     ((bvar m 7 0)
			      (bvar b2 6 0)
			      (bvar r11 1 0)
			      (applic
			       (bvar r12 0 0)
			       ((bvar z 9 0)))
			      (fvar U11)))))
			  ((bvar r11 1 0)))))
		       ((applic
			 (applic
			  (applic
			   (bvar b2 6 0)
			   ((applic
			     (fvar quintuple)
			     ((bvar m 7 0)
			      (bvar b2 6 0)
			      (applic
			       (bvar r12 0 0)
			       ((bvar w 8 0)))
			      (applic
			       (bvar r12 0 0)
			       ((bvar w 8 0)))
			      (fvar U11)))))
			  ((applic
			    (fvar quintuple)
			    ((bvar m 7 0)
			     (bvar b2 6 0)
			     (applic
			      (bvar r12 0 0)
			      ((bvar w 8 0)))
			     (applic
			      (bvar r12 0 0)
			      ((bvar w 8 0)))
			     (fvar U11)))))
			 ((applic
			   (bvar r12 0 0)
			   ((bvar w 8 0)))))))
		      ((fvar I))))))))))))))))))))
>> (define Yn
     (lambda fs
       (let ((ms (map
		     (lambda (fi)
		       (lambda ms
			 (apply fi (map (lambda (mi)
					  (lambda args
					    (apply (apply mi ms) args))) ms))))
		   fs)))
	 (apply (car ms) ms))))
(def (fvar Yn)
     (lambda-var
      fs
      (tc-applic
       (lambda-simple
	(ms)
	(tc-applic
	 (fvar apply)
	 ((applic (fvar car) ((pvar ms 0))) (pvar ms 0))))
       ((applic
	 (fvar map)
	 ((lambda-simple
	   (fi)
	   (lambda-var
	    ms
	    (tc-applic
	     (fvar apply)
	     ((bvar fi 0 0)
	      (applic
	       (fvar map)
	       ((lambda-simple
		 (mi)
		 (lambda-var
		  args
		  (tc-applic
		   (fvar apply)
		   ((applic
		     (fvar apply)
		     ((bvar mi 0 0) (bvar ms 1 0)))
		    (pvar args 0)))))
		(pvar ms 0)))))))
	  (pvar fs 0)))))))
